home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / pctj8309.arc / BOXES2.BAS < prev    next >
BASIC Source File  |  1984-01-23  |  2KB  |  69 lines
  1. 100 'File: BOXES2.BAS
  2. 110 'Auth: T. Hoffmann -- 13 June 1983
  3. 120 '
  4. 130 ' Illustrates COLORPLUS extended medium resolution
  5. 140 ' graphics mode (300 by 200 by 4, 16 colors)
  6. 150 '
  7. 160 '
  8. 170 '--- Definitions
  9. 180 '
  10. 185 DEFINT A-Z
  11. 190 COLORREG = &H3D9    '-- Color Select Register
  12. 200 EMODEREG = &H3DD    '-- Extended Mode Register
  13. 210 MRES = &H10         '-- Medium Res
  14. 220 HRES = &H20         '-- High Res
  15. 230 PLANE1=&H40         '-- Plane select
  16. 235   P0=MRES: P1=MRES+PLANE1
  17. 240 '
  18. 250 '-- Select Color Adapter
  19. 260 '   and Extended Medium Resolution
  20. 270 '
  21. 275 MONO = 1    '-- Set to 0 if no monochrome adapter
  22. 280 GOSUB 9000
  23. 290 SCREEN 0: SCREEN 1
  24. 295 KEY OFF
  25. 300 OUT EMODEREG, P0: CLS: OUT EMODEREG, P1: CLS
  26. 310 OUT COLORREG, 0
  27. 320 '
  28. 330 '-- Repeat Until F10 Key
  29. 340 '
  30. 350 KEY (10) ON: ON KEY (10) GOSUB 9900
  31. 360 WHILE 1
  32. 370   '-- Generate Position, Size, and Color
  33. 380   X=RND*300: Y=RND*200
  34. 390   R=60*RND+10
  35. 400   C=(C+1) MOD 16
  36. 410 '
  37. 420   '-- Separate Colors for Each Plane
  38. 430   C0 = (C AND 6) / 2
  39. 440   C1 = (C AND 8) / 8 + (C AND 1) * 2
  40. 450 '
  41. 460   '-- Draw and Paint in Each Plane
  42. 470   OUT EMODEREG, P0
  43. 480   GOSUB 600: PAINT (X+3,Y+3),C0,3
  44. 490   OUT EMODEREG, P1
  45. 500   GOSUB 600: PAINT (X+3,Y+3),C1,3
  46. 510 '
  47. 520 WEND
  48. 600 '-- Draw Box with color 3, inside color 0
  49. 610   LINE (X,Y)-STEP (R,R),3,BF
  50. 620   LINE (X+1,Y+1)-STEP (R-2,R-2),0,BF
  51. 630 RETURN
  52. 9000 '----------
  53. 9010 ' Switch to Color/Graphics Display
  54. 9020 DEF SEG=0: A=PEEK(&H410): POKE &H410,(A AND &HCF) OR &H20
  55. 9030 WIDTH 40: SCREEN 1: SCREEN 0: LOCATE ,,1,6,7
  56. 9040 RETURN
  57. 9050 '----------
  58. 9060 ' Conditionally Switch to Monochrome Display
  59. 9070 IF MONO <> 1 THEN LOCATE 1,1: RETURN
  60. 9080 DEF SEG=0: A=PEEK(&H410): POKE &H410,(A OR &H30)
  61. 9090 WIDTH 80: LOCATE ,,1,12,13: SCREEN 0,0,0
  62. 9100 KEY ON
  63. 9110 RETURN
  64. 9900 '----------
  65. 9910 ' F10 Gets Here to Exit
  66. 9920 '
  67. 9930 GOSUB 9050 '-- return to monochrome
  68. 9940 END        '-- and quit
  69.